home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / FLASH.PAS < prev    next >
Pascal/Delphi Source File  |  1985-05-26  |  5KB  |  209 lines
  1. program flash;
  2.  
  3. type    registers = record
  4.                       ax, bx, cx, dx, bp, si, di, ds, es, flags: integer
  5.                     end;
  6.  
  7.         page_ptr = ^page;
  8.         page     = packed array[0..4095] of char;
  9.  
  10.         cursor_rec = record
  11.                        cur_x, cur_y: byte;
  12.                        cur_mode    : integer;
  13.                      end;
  14.  
  15.         s80      = string[80];
  16.  
  17.         mode_type= (save, view);
  18.  
  19. var     cmd_line    : s80 absolute cseg:$0080;
  20.         cmd_len     : integer;
  21.         regs        : registers;
  22.         mesg        : s80;
  23.         page_num    : integer;
  24.         p1,
  25.         p2,
  26.         temp        : page_ptr;
  27.         cursor_1,
  28.         cursor_2,
  29.         cursor_temp : cursor_rec;
  30.         mode        : mode_type;
  31.  
  32.  
  33. procedure get_cursor( page: byte; var cursor: cursor_rec );
  34. begin
  35.   regs.ax := $0300;
  36.   regs.bx := page shl 8;
  37.   intr($10, regs);
  38.   with cursor do
  39.     begin
  40.       cur_x := regs.dx and $ff;
  41.       cur_y := regs.dx shr 8;
  42.       cur_mode := regs.cx;
  43.     end
  44. end;
  45.  
  46.  
  47. procedure set_cursor( page: byte; var cursor: cursor_rec );
  48. begin
  49.   regs.ax := $0200;
  50.   regs.bx := page shl 8;
  51.   with cursor do
  52.     begin
  53.       regs.dx := cur_x + cur_y * $100;
  54.       regs.cx := cur_mode
  55.     end;
  56.   intr($10, regs)
  57. end;
  58.  
  59.  
  60. procedure hide_display;
  61. var       crt_mode_set: ^byte;
  62. begin
  63.   crt_mode_set  := ptr($0040, $0065);
  64.   crt_mode_set^ := crt_mode_set^ and $F7;
  65.   port[$03d8]   := crt_mode_set^
  66. end;
  67.  
  68.  
  69. procedure restore_display;
  70. var       crt_mode_set: ^byte;
  71. begin
  72.   crt_mode_set  := ptr($0040, $0065);
  73.   crt_mode_set^ := crt_mode_set^ and $F7 + $08;
  74.   port[$03d8]   := crt_mode_set^
  75. end;
  76.  
  77.  
  78. procedure select_page( page: byte);
  79. begin
  80.   regs.ax := $0500 + page;
  81.   intr($10, regs)
  82. end;
  83.  
  84.  
  85. function has_cga: boolean;
  86. var      base_6845: ^integer;
  87. begin
  88.   base_6845 := ptr($0040, $0063);
  89.   has_cga := base_6845^ = $3D4
  90. end;
  91.  
  92.  
  93. procedure get_args( var page_num: integer; var mode: mode_type );
  94. var       i : integer;
  95. begin
  96.   cmd_len := length(cmd_line) + 7;
  97.   i := pos('s', cmd_line);
  98.   if i = 0 then i := pos('S', cmd_line);
  99.   if i > 0 then mode := save else mode := view;
  100.   i := pos('1', cmd_line);
  101.   if i > 0 then page_num := 1 else
  102.     begin
  103.       i := pos('2', cmd_line);
  104.       if i > 0 then page_num := 2 else
  105.         begin
  106.           i := pos('3', cmd_line);
  107.           if i > 0 then page_num := 3 else page_num := 0
  108.         end
  109.     end
  110. end;
  111.  
  112.  
  113. procedure give_message;
  114. begin
  115.   clrscr;
  116.   writeln('FLASH   copyright 1985 - John D. Falconer');
  117.   writeln;
  118.   writeln('Usage:  FLASH <1..3> [S]');
  119.   writeln;
  120.   writeln('         1..3  - specify a video page number on the CGA,');
  121.   writeln('            S  - save the current screen.');
  122.   writeln;
  123.   writeln('                 If S is not on the command line the selected video ');
  124.   writeln('                 page will be displayed until any key is pressed.');
  125.   writeln;
  126.   write(  '                 { requires color graphics adaptor }')
  127. end;
  128.  
  129.  
  130. procedure clear_from_cursor( p: page_ptr; c: cursor_rec; n: integer );
  131. var       bs  : packed array [0..159] of char;
  132.           attr: char;
  133.           i, c_offset: integer;
  134. begin
  135.   with c do
  136.     begin
  137.       c_offset := 160 * cursor_1.cur_y + 2 * cursor_1.cur_x;
  138.       attr     := p^[c_offset + 1];
  139.       fillchar(bs, sizeof(bs), ' ');
  140.       for i := 1 to n do bs[2 * i] := attr;
  141.       move(bs[1], p1^[c_offset], 2 * n);
  142.     end
  143. end;
  144.  
  145.  
  146. procedure blank_command;
  147. begin
  148.   cursor_1.cur_y := cursor_1.cur_y - 1;
  149.   clear_from_cursor( p1, cursor_1, cmd_len );
  150.   cursor_1.cur_y := cursor_1.cur_y - 1;
  151.   set_cursor( 0, cursor_1 )
  152. end;
  153.  
  154.  
  155. procedure save_page;
  156. begin
  157.   move(p1^, p2^, sizeof(page));
  158.   mesg := 'S A V E D   T O   P A G E   ' + mesg + ' ';
  159.   move(mesg[1], p1^[3998 - length(mesg)], length(mesg));
  160.   restore_display
  161. end;
  162.  
  163.  
  164. procedure view_page;
  165. var       ch: char;
  166. begin
  167.   new(temp);
  168.   move(p1^, temp^, sizeof(page));
  169.   with cursor_2 do
  170.     begin
  171.       cur_x    := 79;
  172.       cur_y    := 24;
  173.       cur_mode := 7
  174.     end;
  175.   set_cursor( 0, cursor_2 );
  176.   move(p2^, p1^, sizeof(page));
  177.   mesg := 'P A G E   ' + mesg + '   < p r e s s   a n y   k e y   t o   c o n t i n u e > ';
  178.   move(mesg[1], p1^[3998 - length(mesg)], length(mesg));
  179.   restore_display;
  180.   read(kbd, ch);
  181.   hide_display;
  182.   move(temp^, p1^, sizeof(page));
  183.   set_cursor( 0, cursor_1 );
  184.   restore_display
  185. end;
  186.  
  187.  
  188. procedure set_up;
  189. begin
  190.   hide_display;
  191.   p1 := ptr($B800, 0);
  192.   p2 := ptr($B800, page_num * 4096);
  193.   get_cursor( 0, cursor_1 );
  194.   blank_command;
  195.   str(page_num:1, mesg)
  196. end;
  197.  
  198.  
  199. begin { main program }
  200.   get_args(page_num, mode);
  201.   if has_cga and (page_num > 0) then
  202.     begin
  203.       set_up;
  204.       if mode = save then save_page else view_page
  205.     end
  206.   else
  207.     give_message
  208. end.
  209.